home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
CMPLTPAS
/
PULLDOWN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-07-24
|
20KB
|
491 lines
{--------------------------------------------------------------}
{ PULLDOWN }
{ }
{ Graphics pull-down menuing system }
{ }
{ by Jeff Duntemann }
{ Turbo Pascal V5.0 }
{ Last update 7/24/88 }
{ }
{ }
{ From: COMPLETE TURBO PASCAL 5.0 by Jeff Duntemann }
{ Scott, Foresman & Co., Inc. 1988 ISBN 0-673-38355-5 }
{--------------------------------------------------------------}
UNIT PullDown;
INTERFACE
USES DOS,Graph,Crt,Mouse; { Mouse is described in Section 17 }
TYPE
String15 = String[15];
ItemRec = RECORD
Item : String15; { Title of item }
ItemCode : Byte; { Code number of item }
ItemActive : Boolean { True if item is active }
END;
MenuRec = RECORD
XStart,XEnd : Word; { Pixel offset along menu bar }
Title : String15; { Menu title }
MenuSize : Word; { Size of menu image on heap }
Imageptr : Pointer; { Points to menu image on heap }
Active : Boolean; { True if menu is active }
Choices : Byte; { Number of items in menu }
ItemList : ARRAY[0..18] OF ItemRec { The items }
END;
MenuDesc = ARRAY[0..12] OF MenuRec; { Up to 13 items along menu bar }
{->>>>ActivateMenu<<<<-----------------------------------------}
{ }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87 }
{ }
{ This routine makes the menu specified by MenuNumber active, }
{ regardless of whether it was active or inactive at }
{ invocation. ImagePtr is set to NIL so that the menu will be }
{ redrawn the next time it is pulled down. }
{ }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be }
{ predefined. }
{--------------------------------------------------------------}
PROCEDURE ActivateMenu(VAR CurrentMenu : MenuDesc;
MenuNumber : Byte);
{->>>>DeactivateMenu<<<<---------------------------------------}
{ }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87 }
{ }
{ This routine makes the menu specified by MenuNumber }
{ inactive, regardless of whether it was active or inactive at }
{ invocation. ImagePtr is set to NIL so that the menu will be }
{ redrawn the next time it is pulled down. }
{ }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be }
{ predefined. }
{--------------------------------------------------------------}
PROCEDURE DeactivateMenu(VAR CurrentMenu : MenuDesc;
MenuNumber : Byte);
{->>>>ActivateItem<<<<-----------------------------------------}
{ }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87 }
{ }
{ This routine sets the item whose code is given in Code to }
{ active, regardless of the state of the item at invocation. }
{ ImagePtr is set to NIL so that the menu will be redrawn }
{ the next time it is pulled down. }
{ }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be }
{ predefined. }
{--------------------------------------------------------------}
PROCEDURE ActivateItem(VAR CurrentMenu : MenuDesc;
Code : Byte);
{->>>>DeactivateItem<<<<---------------------------------------}
{ }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87 }
{ }
{ This routine sets the item whose code is given in Code to }
{ inactive, regardless of the state of the item at invocation. }
{ ImagePtr is set to NIL so that the menu will be redrawn }
{ the next time it is pulled down. }
{ }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be }
{ predefined. }
{--------------------------------------------------------------}
PROCEDURE DeactivateItem(VAR CurrentMenu : MenuDesc;
Code : Byte);
{->>>>InvalidMenu<<<<------------------------------------------}
{ }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87 }
{ }
{ This function checks for duplicate item codes within the }
{ menu array passed in CurrentMenu. The menuing system always }
{ assumes that every menu item has a unique code. Run this }
{ function on any menu array you intend to use and abort if a }
{ duplicate code is detected. }
{ }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be }
{ predefined. }
{--------------------------------------------------------------}
FUNCTION InvalidMenu(CurrentMenu : MenuDesc;
VAR BadCode : Byte) : Boolean;
{->>>>SetupMenu<<<<--------------------------------------------}
{ }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87 }
{ }
{ This routine does the initial display of the menu bar, menu }
{ titles, and the menu bar amulet. }
{ }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be }
{ predefined. }
{--------------------------------------------------------------}
PROCEDURE SetupMenu(CurrentMenu : MenuDesc);
{->>>>Menu<<<<-------------------------------------------------}
{ }
{ Filename : PULLDOWN.PAS -- Last Modified 12/25/87 }
{ }
{ This is the main menuing routine. It requires that both }
{ InvalidMenu and SetupMenu be run before it. It directly }
{ samples the mouse pointer position and decides which menu }
{ within the menu bar has been selected. It then allows the }
{ user to bounce the menu bar up and down within the menu }
{ until an item is chosen or the right button is pressed or }
{ the pointer is moved out of the pulled-down menu. The code }
{ of the chosen item is returned in ReturnCode. If no item is }
{ chosen, ReturnCode comes returns a 0. The returned code is }
{ within the range 0-255. }
{ }
{ Menu is responsible for drawing pull-down menus and storing }
{ them on the heap so that once drawn a menu does not need to }
{ be drawn again until it is changed somehow, typically by }
{ deactivating or reactivating an item. }
{ }
{ Types MenuRec, ChoiceRec, MenuDesc and String15 must be }
{ predefined. }
{--------------------------------------------------------------}
PROCEDURE Menu(CurrentMenu : MenuDesc;
VAR ReturnCode : Word;
VAR Amulet : Boolean);
IMPLEMENTATION
PROCEDURE ChangeItemStatus(VAR CurrentMenu : MenuDesc;
Code : Byte;
ToActive : Boolean);
VAR
I : Byte;
MenuNumber : Byte;
ItemFound : Boolean;
BEGIN
MenuNumber := 0; ItemFound := False;
REPEAT
WITH CurrentMenu[MenuNumber] DO
BEGIN
I := 0;
REPEAT { Here we scan menu items to find the right one }
IF ItemList[I].ItemCode = Code THEN { We found it ! }
BEGIN
ItemList[I].ItemActive := ToActive; { Mark item }
ItemFound := True;
{ Since we've changed the information in a menu, we must }
{ remove any menu image from storage on the heap, and force }
{ the code to redraw the menu the next time it's pulled down: }
IF ImagePtr <> NIL THEN { If there's an image on the heap }
BEGIN
FreeMem(ImagePtr,MenuSize); { Deallocate the heap image }
ImagePtr := NIL { Make pointer NIL again }
END;
END
ELSE
Inc(I)
UNTIL ItemFound OR (I > Choices)
END;
Inc(MenuNumber)
UNTIL ItemFound OR (MenuNumber > 12);
END;
{---------------------------------------------------------------------}
{ IMPLEMENTATION Definitions above this bar are PRIVATE to the unit. }
{---------------------------------------------------------------------}
PROCEDURE ActivateMenu(VAR CurrentMenu : MenuDesc;
MenuNumber : Byte);
BEGIN
WITH CurrentMenu[MenuNumber] DO
BEGIN
ImagePtr := NIL;
Active := True
END
END;
PROCEDURE DeactivateMenu(VAR CurrentMenu : MenuDesc;
MenuNumber : Byte);
BEGIN
WITH CurrentMenu[MenuNumber] DO
BEGIN
ImagePtr := NIL;
Active := False
END
END;
PROCEDURE ActivateItem(VAR CurrentMenu : MenuDesc;
Code : Byte);
BEGIN
ChangeItemStatus(CurrentMenu,Code,True)
END;
PROCEDURE DeactivateItem(VAR CurrentMenu : MenuDesc;
Code : Byte);
BEGIN
ChangeItemStatus(CurrentMenu,Code,False)
END;
FUNCTION InvalidMenu(CurrentMenu : MenuDesc;
VAR BadCode : Byte) : Boolean;
VAR
I,J : Word;
CmdSet : SET OF Byte;
DuplicateFound : Boolean;
BEGIN
DuplicateFound := False;
CmdSet := []; { Start out with the empty set }
FOR I := 0 TO 12 DO { Check each menu }
WITH CurrentMenu[I] DO
BEGIN
J := 0; { Reset item counter to 0 for each new menu }
REPEAT { Here we scan menu items to check each one }
IF ItemList[J].ItemCode > 0 THEN
IF ItemList[J].ItemCode IN CmdSet THEN
BEGIN
DuplicateFound := True; { Flag duplicate }
BadCode := ItemList[J].ItemCode { Return dupe in BADCODE }
END
ELSE
BEGIN
{ Add item's command code to the set: }
CmdSet := CmdSet + [ItemList[J].ItemCode];
Inc(J)
END
ELSE Inc(J)
UNTIL (J > Choices) OR DuplicateFound
END;
InvalidMenu := DuplicateFound
END;
PROCEDURE SetupMenu(CurrentMenu : MenuDesc);
VAR
I,DrawX,DrawY : Word;
BEGIN
{ Show bar and amulet: }
SetFillStyle(SolidFill,White); Bar(0,0,GetMaxX,11);
SetColor(0); Rectangle(2,1,12,9);
FOR I := 3 TO 8 DO IF Odd(I) THEN Line(4,I,10,I);
{ Display menu titles in bar: }
DrawX := CurrentMenu[0].XStart; DrawY := 2; I := 0;
REPEAT
OutTextXY(DrawX,DrawY,CurrentMenu[I].Title);
Inc(I);
DrawX := CurrentMenu[I].XStart;
UNTIL (Length(CurrentMenu[I].Title) = 0) OR (I > 13);
END;
PROCEDURE Menu(CurrentMenu : MenuDesc;
VAR ReturnCode : Word;
VAR Amulet : Boolean);
VAR
PointerX,PointerY : Word; { Current position of mouse pointer }
Left,Center,Right : Boolean; { Current state of mouse buttons }
I,J : Integer;
MenuWidth : Integer; { Width in pixels of target menu }
M1X,M1Y,M2X,M2Y : Integer; { Coordinates of menu box }
FoundMenu : Boolean;
SaveColor : Integer; { Holds caller's draw color }
UnderMenu : Pointer; { Points to saved screen area }
BounceBar : Pointer; { Points to bounce bar pattern }
Pick : Word; { Number of item under bounce bar }
UpperBound,
LowerBound : Integer; { Current Y-limits of bounce bar }
PROCEDURE RestoreUnderMenuBox;
BEGIN
PointerOff;
PutImage(M1X,M1Y,UnderMenu^,NormalPut);
PointerOn
END;
BEGIN
Amulet := False;
SaveColor := GetColor; SetColor(White);
PollMouse(PointerX,PointerY,Left,Right,Center);
{ Check to see if the amulet is under mouse pointer: }
IF (PointerX > 1) AND (PointerX < 13) AND
(PointerY > 0) AND (PointerY < 10)
THEN
BEGIN
Amulet := True; { We've clicked on the amulet }
SetColor(SaveColor);
Exit { THIS IS AN EXIT TO MENU! }
END;
{ Now we find out which menu to pull down: }
I := -1;
REPEAT
I := I + 1;
IF (PointerX >= CurrentMenu[I].XStart) AND { If pointer is in }
(PointerX <= CurrentMenu[I].XEnd) AND { menu's range }
CurrentMenu[I].Active { and menu is active }
THEN FoundMenu := True ELSE FoundMenu := False;
UNTIL FoundMenu OR { We hit an active menu }
(Length(CurrentMenu[I].Title) = 0) OR { We hit a null menu }
(I > 13); { Only 13 menus max! }
IF FoundMenu THEN { Pull it down and pick! }
BEGIN
PointerOff;
WITH CurrentMenu[I] DO { We're only working with current menu now }
BEGIN
{ Calc coordinates of the found menu box: }
MenuWidth := 0; { First we have to calc menu width : }
FOR J := 0 TO Choices-1 DO { Find longest item string }
IF Length(ItemList[J].Item) > MenuWidth
THEN MenuWidth := Length(ItemList[J].Item);
MenuWidth := MenuWidth * 8; { We're using the 8 X 8 font }
M1X := XStart; M1Y := 11;
M2X := XStart+MenuWidth+6;
M2Y := (Choices+1) * 12;
MenuSize := ImageSize(M1X,M1Y,M2X,M2Y);
{ We must save the screen area beneath the menu box: }
GetMem(UnderMenu,MenuSize); { Allocate space on heap }
GetImage(M1X,M1Y,M2X,M2Y,UnderMenu^); { Save area out to heap }
{ First we clear the menu box: }
SetFillStyle(SolidFill,Black);
Bar(M1X,M1Y,M2X,M2Y);
{ Here we create the bounce bar pattern on the heap: }
SetFillStyle(SolidFill,White);
GetMem(BounceBar,ImageSize(M1X+1,M1Y+1,M2X-1,M1Y+12));
Bar(M1X+1,M1Y+1,M2X-1,M1Y+12);
GetImage(M1X+1,M1Y+1,M2X-1,M1Y+12,BounceBar^);
{ If the menu has not yet been shown for the first time, or if }
{ the active/inactive status of any menu item has changed since }
{ we last pulled it down, the image pointer is NIL and we must }
{ draw it and then store it on the heap. Any time AFTER the }
{ first time it comes in from the heap with lightning speed... }
IF ImagePtr = NIL THEN { We must draw the menu }
BEGIN
Rectangle(M1X,M1Y,M2X,M2Y); { Draw the menu box }
{ The first item must be drawn in black on the white bar: }
SetColor(Black);
IF ItemList[0].ItemActive THEN
OutTextXY(XStart+3,14,ItemList[0].Item);
SetColor(White);
{ Items after the first are drawn in white on black: }
FOR J := 1 TO Choices-1 DO IF ItemList[J].ItemActive THEN
OutTextXY(XStart+3,14+(J*12),ItemList[J].Item);
{ Now we allocate heap space and move image to heap }
GetMem(ImagePtr,MenuSize);
GetImage(M1X,M1Y,M2X,M2Y,ImagePtr^);
END;
{ Bring the menu box image in from the heap: }
PutImage(M1X,M1Y,ImagePtr^,NormalPut);
PointerOn; { We need the pointer on to bounce the bar }
{ Now we enter the "bounce loop" that moves the bounce bar }
{ up and down the menu box, attached to the mouse pointer: }
UpperBound := 12; LowerBound := 24; Pick := 0;
REPEAT
PollMouse(PointerX,PointerY,Left,Center,Right);
{ If the pointer leaves the menu box, it's an "escape" }
{ identical in effect to pressing the right button: }
IF (PointerX < M1X) OR (PointerX > M2X) OR
(PointerY > M2Y) THEN Right := True
ELSE
BEGIN
IF PointerY < UpperBound THEN { We bounce the bar UPWARD: }
IF PointerY > 12 THEN { If we're not above the top line }
BEGIN
PointerOff;
{ Erase bar at current position if item is active: }
IF ItemList[Pick].ItemActive THEN
PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
{ Decrement bounds and pick number: }
UpperBound := UpperBound - 12;
LowerBound := LowerBound - 12;
Pick := Pick - 1;
{ Show bar at new position if item is active: }
IF ItemList[Pick].ItemActive THEN
PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
PointerOn;
END;
IF PointerY > LowerBound THEN
BEGIN
PointerOff;
{ Erase bar at current position if item is active: }
IF ItemList[Pick].ItemActive THEN
PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
{ Increment bounds and pick number: }
UpperBound := UpperBound + 12;
LowerBound := LowerBound + 12;
Pick := Pick + 1;
{ Show bar at new position if item is active: }
IF ItemList[Pick].ItemActive THEN
PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
PointerOn;
END;
END;
UNTIL (NOT Left) OR Right;
RestoreUnderMenuBox;
{ Now we set up the function return code. The right button }
{ always indicates "escape;" i.e., 0; Take No Action. }
{ Picking an inactive menu item also returns a 0. An active }
{ item returns its item code as the function result. }
IF Right THEN ReturnCode := 0
ELSE IF ItemList[Pick].ItemActive THEN
ReturnCode := ItemList[Pick].ItemCode
ELSE ReturnCode := 0
END; { WITH statement }
PointerOn;
END;
SetColor(SaveColor); { Restore caller's drawing color }
END;
{ No initialization section...}
END.